www.gusucode.com > 环保时代家庭财务管理系统 EPffms v4.0 > 环保时代家庭财务管理系统 EPffms v4.0\code\eptimehome\updata.asp
<link href="images/admin.css" rel="stylesheet" type="text/css" /> <% const url="http://home.eptime.cn/updata/" action=request("action") if action="updata" then download(url&"eptimeupdata.txt") download(url&"eptimeupdata.jpg") response.Write("下载成功!<a href='updata.asp?action=install'>安装升级程序</a>") elseif action="install" then str=openfile("eptimeupdata.txt") if str="" then response.write "缺少本地配置文件eptimeupdata.txt" else size=RegExpTest("size",str) call install("eptimeupdata.jpg",size) end if else str=getpage(url&"eptimeupdata.txt") if str="" then response.write "不存在可用更新或者本地配置不正确" response.end end if str1=openfile("eptimeupdata.txt") if str1="" then response.write "缺少本地配置文件eptimeupdata.txt无法获知本地程序的安装时间" response.end end if updatatime=RegExpTest("time",str) updatatime1=RegExpTest("time",str1) if DateDiff("d",updatatime1,updatatime)>0 then response.Write("存在可用更新,更新日期:"&updatatime&"<a href='updata.asp?action=updata'>下载</a>") else response.write "您的程序是最新的了!" end if end if function openfile(filename) set fso=server.CreateObject("scripting.filesystemobject") if fso.fileexists(server.MapPath(filename)) then set f1=fso.opentextfile(server.mappath(filename),1,true) openfile=f1.readall f1.close else openfile="" end if set fso=nothing end function function getpage(url) set xmlhttp=server.createobject("Microsoft.XMLHTTP") xmlhttp.open "get",url,false xmlhttp.send if xmlhttp.status<>200 then getpage="" else getpage=bytes2BSTR(xmlhttp.ResponseBody) end if end function Function bytes2BSTR(vIn) dim strReturn dim i,ThisCharCode,NextCharCode strReturn = "" For i = 1 To LenB(vIn) ThisCharCode = AscB(MidB(vIn,i,1)) If ThisCharCode < &H80 Then strReturn = strReturn & Chr(ThisCharCode) Else NextCharCode = AscB(MidB(vIn,i+1,1)) strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) i = i + 1 End If Next bytes2BSTR = strReturn End Function Function RegExpTest(patrn,strng) Dim regEx,Match,Matches'建立变量。 Set regEx = New RegExp'建立正则表达式。 regEx.Pattern = patrn&"=(.+?)\n"'设置模式。 regEx.IgnoreCase = True'设置是否区分字符大小写。 regEx.Global = True'设置全局可用性。 Set Matches = regEx.Execute(strng)'执行搜索。 For Each Match in Matches'遍历匹配集合。 RetStr = Match.Value Next RegExpTest = replace(RetStr,patrn&"=","") End Function function download(url) temp=split(url,"/") filename=temp(ubound(temp)) set xmlhttp=server.createobject("Microsoft.XMLHTTP") xmlhttp.open "get",url,false xmlhttp.send if xmlhttp.status<>200 then download="" else set fso=server.createobject("scripting.filesystemobject") if fso.fileexists(server.mappath(filename)) then fso.deletefile(server.mappath(filename)) end if set fso=nothing img=xmlhttp.ResponseBody set objAdostream=server.createobject("ADODB.Stream") objAdostream.Open objAdostream.type=1 objAdostream.Write(img) objAdostream.SaveToFile(server.mappath(filename)) objAdostream.SetEOS set objAdostream=nothing download=filename end if set xmlhttp=nothing end function function install(filename,size) on error resume next path=server.mappath("./") set fso=server.createobject("scripting.filesystemobject") set s=server.createobject("adodb.stream") set s1=server.createobject("adodb.stream") set s2=server.createobject("adodb.stream") s.open s1.open s2.open s.type=1 s1.type=1 s2.type=1 s.loadfromfile(server.mappath(filename)) s.position=size s1.write(s.read) s1.position=0 s1.type=2 s1.charset="gb2312" s1.position=0 a=split(s1.readtext,vbcrlf) s.position=0 i=0 while(i<ubound(a)) b=split(a(i),">") if b(0)="folder" then if not fso.folderexists(path&b(2)) then fso.createfolder(path&b(2)) end if elseif b(0)="file" then if fso.fileexists(path&b(2)) then fso.deletefile(path&b(2)) end if s2.position=0 s2.write(s.read(b(1))) s2.seteos s2.savetofile(path&b(2)) end if i=i+1 wend s.close s1.close s2.close set s=nothing set s1=nothing set s2=nothing set fso=nothing if err.number<>0 then response.write err.description else response.write "升级程序安装成功!" end if end Function %>